4 REM   ******************************************

6 REM   ** (DFT4.03A) GENERATE/ANALYZE WAVEFORM **

8 REM   ******************************************

10 Q = 32

12 PI = 3.141592653589793#: P2 = 2 * PI: K1 = P2 / Q: K2 = 1 / PI

14 DIM C(2, Q), S(2, Q), KC(2, Q), KS(2, Q)

16 CLS : FOR J = 0 TO Q: FOR I = 1 TO 2: C(I, J) = 0: S(I, J) = 0: NEXT: NEXT

20 CLS : REM *    MAIN MENU    *

22 PRINT : PRINT : PRINT "         MAIN MENU": PRINT

24 PRINT " 1 = SHIFTING THEOREM": PRINT

31 PRINT " 2 = EXIT": PRINT : PRINT

32 PRINT SPC(10); "MAKE SELECTION";

34 A$ = INKEY$: IF A$ = "" THEN 34

36 A = VAL(A$): ON A GOSUB 300, 1000

38 GOTO 20

40 CLS : N = 1: M = 2: K5 = Q: K6 = -1: GOSUB 108

42 FOR J = 0 TO Q: C(2, J) = 0: S(2, J) = 0: NEXT

44 GOSUB 200: REM - PERFORM DFT

46 GOSUB 140: REM - PRINT OUT FINAL VALUES

48 PRINT : INPUT "C/R TO CONTINUE"; A$

50 RETURN

80 CLS : GOSUB 150: REM PRINT HEADING

81 FOR I = 0 TO Q - 1: C(1, I) = 0: S(1, I) = 0: NEXT

82 N = 2: M = 1: K5 = 1: K6 = 1

84 GOSUB 200: REM INVERSE TRANSFORM

86 GOSUB 140: REM PRINT OUTPUT

88 PRINT : INPUT "C/R TO CONTINUE"; A$

90 RETURN

100 REM  ******************************************

102 REM  *         PROGRAM SUBROUTINES            *

104 REM  ******************************************

106 REM  *       PRINT COLUMN HEADINGS            *

108 PRINT : PRINT : IF COR$ = "P" THEN 116

110 PRINT "FREQ    F(COS)      F(SIN)      FREQ     F(COS)    F(SIN)"

112 PRINT

114 RETURN

116 PRINT "FREQ      F(MAG)       F(THETA)    FREQ       F(MAG)     F(THETA)"

118 GOTO 112

137 REM ******************************

138 REM *       PRINT OUTPUT         *

139 REM ******************************

140 IF COR$ = "P" THEN GOSUB 170

141 FOR Z = 0 TO Q / 2 - 1

142 PRINT USING "##_     "; Z;

144 PRINT USING "+###.#####_    "; C(M, Z); S(M, Z);

145 PRINT USING "##_    "; (Z + Q / 2);

146 PRINT USING "+###.#####_    "; C(M, Z + Q / 2); S(M, Z + Q / 2)

147 NEXT Z

148 RETURN

150 REM ******************************

152 REM *    PRINT COLUMN HEADINGS   *

154 PRINT

156 PRINT "                       RECONSTRUCTION": PRINT

158 PRINT " T                              T": PRINT

160 RETURN

170 REM CONVERT FROM RECTANGULAR TO POLAR COORDINATES

172 FOR I = 0 TO Q - 1

174 MAG = SQR(C(M, I) ^ 2 + S(M, I) ^ 2)

175 IF C(M, I) = 0 THEN 190

176 ANGLE = 180 / PI * ATN(S(M, I) / C(M, I))

177 IF C(M, I) > 0 THEN S(M, I) = ANGLE: GOTO 180

178 IF ANGLE > 0 THEN S(M, I) = ANGLE - 180

179 IF ANGLE < 0 THEN S(M, I) = ANGLE + 180

180 C(M, I) = MAG: NEXT

182 RETURN

190 IF S(M, I) = 0 THEN S(M, I) = 0: GOTO 180

192 S(M, I) = 90: GOTO 180

200 REM *******************************

202 REM *     TRANSFORM/RECONSTRUCT   *

204 REM *******************************

206 FOR J = 0 TO Q - 1: REM SOLVE EQNS FOR EACH FREQUENCY

208 FOR I = 0 TO Q - 1: REM MULTIPLY AND SUM EACH POINT

210 C(M, J) = C(M, J) + C(N, I) * COS(J * I * K1) + K6 * S(N, I) * SIN(J * I * K1)

211 S(M, J) = S(M, J) - K6 * C(N, I) * SIN(J * I * K1) + S(N, I) * COS(J * I * K1)

212 NEXT I

214 C(M, J) = C(M, J) / K5: S(M, J) = S(M, J) / K5: REM SCALE RESULTS

216 NEXT J

218 RETURN

220 REM *******************************

222 REM *        PLOT FUNCTIONS       *

224 REM *******************************

226 SCREEN 9, 1, 1, 1: COLOR 9, 1: CLS : YS = -1: ZS = -1

228 LINE (0, 5)-(0, 155): LINE (0, 160)-(0, 310)

230 LINE (0, 155)-(600, 155): LINE (0, 235)-(600, 235)

232 GOSUB 266

234 COLOR 15, 1

236 FOR N = 0 TO Q - 1

238 GOSUB 260

240 LINE (X, Y)-(X, Y): LINE (X, Z)-(X, Z)

242 NEXT N

244 LOCATE 4, 15: PRINT "FREQUENCY DOMAIN (MAG)"

246 LOCATE 18, 15: PRINT "FREQUENCY DOMAIN (THETA)"

248 LOCATE 24, 1

250 INPUT "C/R TO CONTINUE"; A$

252 SCREEN 0, 0, 0

254 RETURN

256 REM *******************************

260 Y = C(2, N): Y = 155 - (YS * Y)

262 X = N * 600 / Q: Z = 235 - (ZS * S(2, N))

264 RETURN

265 REM *******************************

266 YS = 150 / 32: ZS = 75 / 180: LINE (0, 5)-(5, 5): LINE (0, 80)-(5, 80)

268 LINE (0, 160)-(5, 160): LINE (0, 235)-(5, 235)

270 LOCATE 1, 2: PRINT "32": LOCATE 6, 2: PRINT "16"

272 LOCATE 12, 2: PRINT "+180": LOCATE 23, 2: PRINT "-180"

274 RETURN

299 REM *******************************

300 CLS : REM *    SHIFTING THEOREM    *

301 REM *******************************

302 FOR I = 0 TO Q - 1: C(1, I) = 0: S(1, I) = 0

304 FOR J = 1 TO 2: KC(J, I) = 0: KS(J, I) = 0: NEXT: NEXT

305 COR$ = "P"

306 GOSUB 900

308 REM *** GENERATE IMPULSE FUNCTION ***

310 PRINT : PRINT SPC(18); "IMPULSE FUNCTION": PRINT

312 C(1, 0) = 32

314 GOSUB 158: REM PRINT HEADING

316 M = 1: GOSUB 140: REM PRINT INPUT FUNCTION

318 PRINT : INPUT "C/R TO CONTINUE"; A$

320 GOSUB 40: REM TAKE XFORM

322 GOSUB 220: REM PLOT DATA

324 FOR I = 0 TO Q - 1: C(1, I) = 0: S(1, I) = 0: NEXT

326 INPUT "AMOUNT OF SHIFT (0-31)"; S9

328 C(1, S9) = 32

330 GOSUB 158: REM PRINT HEADING

332 M = 1: GOSUB 140: REM PRINT INPUT FUNCTION

334 PRINT : INPUT "C/R TO CONTINUE"; A$

336 GOSUB 40: REM TAKE XFORM

338 GOSUB 220: REM PLOT DATA

340 PRINT "CONTINUE ILLUSTRATION ? (Y/N)"

342 A$ = INKEY$: IF A$ = "" THEN 342

344 IF A$ = "Y" THEN 324

346 RETURN

900 CLS : SCREEN 9, 1, 1: COLOR 15, 1: REM TEST DESCRIPTION

902 FOR DACNT = 1 TO 10

904 READ A$: PRINT A$

906 NEXT

908 INPUT "C/R TO CONTINUE"; A$

910 SCREEN 0, 0, 0: RETURN

920 DATA "                TEST 1"

922 DATA " "

924 DATA "In this illustration we generate an impulse function (i.e. a single"

926 DATA "data point at the beginning of the time domain with an amplitude"

928 DATA "of 32.  This function is transformed providing a spectrum of"

930 DATA "unit sinusoids all with a phase of 0 degrees.  In this illustration"

932 DATA "we do not plot the time domain function but instead, we plot"

934 DATA "both the magnitude and the phase of the frequency domain function."

936 DATA " "

938 DATA " "

940 DATA "                TEST 2"

942 DATA " "

944 DATA "In the second part of this illustration the user is allowed"

946 DATA "to select the time domain shift of the input function.  The "

948 DATA "transform is taken, displayed and plotted (again, both"

950 DATA "magnitude and phase if the frequency domain function is plotted)."

952 DATA " "

954 DATA " "

956 DATA " "

958 DATA " "

1000 STOP



